The Original Shareware 1.1

home *** CD-ROM | disk | FTP | other *** search

/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 32 / birdsong.zip / BIRDSONG.BAS next >

Wrap

BASIC Source File | 1987-03-17 | 20KB | 443 lines

1 '**** BIRDSOND.BAS **** Program to play bird's songs 2 '**** 3 KEY OFF: SCREEN 0: WIDTH 80: KEY(8) ON: ON KEY(8) GOSUB 65000 4 DEF SEG = 0: IF (PEEK(&H410) AND &H30) <> &H30 THEN GRAPH.ICS=1 5 IF GRAPH.ICS THEN FC=3: BC=4 ELSE FC=7 10 '** 11 '(C) Copyright 1984 SCOTT CAMAZINE & P. KIRK VISSCHER 12 KEY OFF: CLS: SCREEN 0 'set up screen 15 LOCATE ,,0 'turn off blinking cursor 30 ON ERROR GOTO 62000 'error trapping routine 50 GOSUB 60000 'introduction 95 DIM A(640) 'array to hold plotted points 97 DIM B%(640) 'array to hold frequencies 102 CLS 104 DEF SEG = 0: IF (PEEK(&H410) AND &H30) <> &H30 THEN GRAPH.ICS=1 108 GOSUB 41000 'option to get a song from a file 109 CLS 110 IF GRAPH.ICS <>1 THEN CLS: LOCATE 10,10,0: PRINT "You need graphics to create a song.": LOCATE 14,10: PRINT "Press any key to continue."; ELSE GOTO 118 111 IF INKEY$="" THEN 111 ELSE GOTO 102 118 LOCATE 12,15:PRINT "Initializing; please wait"; 120 FOR I = 1 TO 640: B%(I)=&HFFFF: IF I MOD 32 = 0 THEN PRINT "-"; 121 NEXT I 'initialize at inaudible 122 IF GRAPH.ICS THEN GOSUB 6000 'set up graphics screen grid 172 KEY (10) ON 185 ON KEY(10) GOSUB 3000 'play sound 190 FREQ.SCALE.FACTOR = 40 195 CX = 20: CY = 185 'initialize cursor position 196 DRAWFLAG = 0 'cursor drawing routine toggle 197 FLAG = 0 'flag = 1 for playing a file 198 YINCREMENT = -1 'cursor drawing frequency increment 199 RADIUS = 1 'radius of circle drawn 202 ' 500 '--------------- setup for cursor routines 501 ' 504 KEY(5) ON 505 KEY(9) ON 510 FOR I = 11 TO 14: KEY (I) ON: NEXT I 512 ON KEY(5) GOSUB 2500 'toggle drawing off/on 515 ON KEY(9) GOSUB 4000 'redraw the graph 520 ON KEY(11) GOSUB 2100 'cursor up 522 ON KEY(14) GOSUB 2200 'cursor down 524 ON KEY(13) GOSUB 2300 'cursor right 526 ON KEY(12) GOSUB 2400 'cursor left 540 ' 2000 '** CURSOR KEY SUBROUTINE FOR DATA ENTRY 2001 ' 2010 IF CX =< 15 THEN CX = 15 'trap out of range 2015 IF CX >= 640 THEN CX = 640 2020 IF CY =< 10 THEN CY = 10 2025 IF CY >= 190 THEN CY = 190 2030 CIRCLE (CX,CY),RADIUS,1 2045 IF DRAWFLAG = 1 THEN A(CX) = CY 2046 IF DRAWFLAG = 1 THEN B%(CX) = 26775/(191-CY) 2070 GOTO 2000 2071 ' 2100 '---- cursor up 2101 ' 2105 IF DRAWFLAG = 0 THEN CIRCLE (CX,CY),RADIUS,0 'erase previous point 2110 CY = CY + YINCREMENT 2115 RETURN 2120 ' 2200 '---cursor down 2201 ' 2205 IF DRAWFLAG = 0 THEN CIRCLE (CX,CY),RADIUS,0 'erase previous point 2210 CY = CY - YINCREMENT 2215 RETURN 2220 ' 2300 '--- cursor right 2301 ' 2305 IF DRAWFLAG = 0 THEN CIRCLE (CX,CY),RADIUS,0 'erase previous point 2310 CX = CX + 1: IF CX=640 THEN BEEP:CX=639 2315 RETURN 2320 ' 2400 '--- cursor left 2401 ' 2405 IF DRAWFLAG = 0 THEN CIRCLE (CX,CY),RADIUS,0 'erase previous point 2410 CX = CX - 1 2415 RETURN 2420 ' 2500 '--- toggle drawflag on/off 2501 ' 2505 IF DRAWFLAG = 1 THEN DRAWFLAG = 0: GOTO 2520 2510 IF DRAWFLAG = 0 THEN DRAWFLAG = 1: 2520 RETURN 2521 ' 3000 '*** subroutine to play the sound 3001 ' 3005 IF GRAPH.ICS THEN GOSUB 4000 'redraw the pattern 3010 LOCATE 1,1: PRINT STRING$(75,32); 'clear line #1 3015 LOCATE 1,45 3016 PRINT "Press [Esc] to end the song" 3017 LOCATE 1,15: PRINT BIRDNAME$ 3139 GOSUB 50000 'machine language subroutine 3141 A$ = INKEY$: IF A$ = CHR$(27) THEN GOTO 3142 ELSE GOTO 3139 3142 IF FLAG = 1 THEN GOTO 3155 'song is alread stored on disk 3148 LOCATE 1,1 3150 GOSUB 40000 'option to store array 3155 CLS 3157 LOCATE 12,18 3160 PRINT "Would you like to see more BIRD SONGS? (y/n)" 3170 DEF SEG=0: POKE &H41A,PEEK(&H41C) '**** Clear keyboard buffer 3175 A$ = INKEY$: IF A$ = "" THEN GOTO 3175 3180 IF A$ = "y" OR A$ = "Y" THEN CLEAR:GOTO 95 ELSE IF A$<>"N" AND A$<>"n" THEN BEEP: GOTO 3175 3181 ' 3183 '--- end program 3184 ' 3190 CLS '... end the program 3192 LOCATE 10,35 3194 PRINT "BIRDSONG" 3196 LOCATE 15,15 3197 PRINT "(C) Copyright 1984 Scott Camazine & P. Kirk Visscher" 3199 FOR WAITE=1 TO 2000: NEXT WAITE: GOTO 65000 3200 ' 4000 '*** subroutine to redraw points already entered 4001 ' 4120 CLS 4122 GOSUB 6000 'redraw grid 4130 FOR I = 1 TO 640 'replot the points 4131 IF A(I) = 0 THEN GOTO 4136 4134 CIRCLE (I+15,A(I)),RADIUS+2,1 4136 NEXT I 4140 RETURN 6000 '*** draw axes 6001 CLS 6005 SCREEN 2 6009 LINE (15,10) - (640,10) 6010 LINE (15,55) - (640,55) 6012 LINE (15,100) - (640,100) 6014 LINE (15,145) - (640,145) 6015 LINE (15,190) - (640,190) 6027 LOCATE 2,1: PRINT "KHz"; 6030 LOCATE 7,1: PRINT "6" 'label frequencies on axis 6035 LOCATE 13,1: PRINT "4" 'label frequencies on axis 6040 LOCATE 19,1: PRINT "2" 'label frequencies on axis 6052 ' 6060 LOCATE 25,29: PRINT "1"; 'label seconds on x axis 6062 LOCATE 25,56: PRINT "2"; 'label seconds on x axis 6063 ' 6092 FOR I = 15 TO 640 STEP 640/6 'tick marks for 1/2 seconds 6094 LINE (I,10)-(I,190) 6095 NEXT I 6096 LINE (639,10)-(639,190) 6097 LOCATE 25,39: PRINT "seconds"; 6105 IF GETFILE$ = "y" OR GETFILE$ = "Y" THEN GOTO 6500 6112 LOCATE 1,10:PRINT "[F5] toggle drawing on/off [F9] review graph [F1O] play song" 6500 RETURN 20000 '--- BIRD DESCRIPTIONS 20001 ' 20003 ON NUMBER GOSUB 21000,22000,23000,24000,25000,26000,27000,28000 20004 'GOSUB 61000 'press any key to continue 20050 RETURN 21000 '--- CARDINAL 21001 ' 21005 SCREEN 0: COLOR 12: LOCATE 1,30 21010 PRINT "CARDINAL" 21015 LOCATE 5,1 21020 PRINT "DESCRIPTION: The cardinal is a common bird of the suburbs, and" 21025 PRINT " a frequent visitor to winter bird feeders. The brilliant red " 21030 PRINT " plummage, pointed crest, and black bib of the male are " 21035 PRINT " unmistakable. The female and immatures are light brown with " 21040 PRINT " hints of red. Their heavy conical bills, red in both sexes, 21045 PRINT " are ideally suited for cracking hard seeds. 21050 PRINT " Cardinals are found over most of the eastern US. 21055 PRINT 21060 PRINT "SONG: A long repetition of loud slurred whistles, occurring" 21065 PRINT " 5-10 per minute. There are over 20 different dialects " 21070 PRINT " to the song, one of which is included here. The dialects" 21075 PRINT " vary their pattern with time and geographical area. 21080 PRINT " Males maintain a large territory of about 6 acres, the " 21085 PRINT " boundaries of which are established by singing from one or" 21090 PRINT " several tall perches in the area. Other males match their" 21095 PRINT " song to neighboring males in singing duels to defend the " 21100 PRINT " territories. A female occasionally sings just before nesting" 21105 PRINT " and matches her song to her partner's even more closely " 21110 PRINT " closely than the male does with his neighbors. "; 21500 RETURN 22000 '--------------------- yellow warbler 22001 ' 22005 SCREEN 0: COLOR 14,0,4: CLS: LOCATE 1,30 22010 PRINT "YELLOW WARBLER " 22015 LOCATE 5,1 22020 PRINT "DESCRIPTION: Easily recognized as the only small bird which" 22025 PRINT " appears to be all yellow. Other warblers have yellow " 22030 PRINT " undersides but none is as yellow on the back, wings or tail." 22035 PRINT " A common resident of suburban shrubbery, willow thickets and" 22040 PRINT " swamp edges. Like most warblers, the yellow warbler eats a " 22045 PRINT " variety of caterpillars, and other insect pests and is thus" 22050 PRINT " of great benefit. This little bird is found throughout most" 22052 PRINT " of the United States, often close to human habitation, but" 22054 PRINT " winters in the tropics. 22055 PRINT 22060 PRINT "SONG: A cheerful `tsee-tsee-tsee-tsee-ti-ti-wee` or 22065 PRINT " `sweet,sweet,sweet...I am so sweet` composed of 7 clear " 22070 PRINT " notes, with the second half of the song being slightly" 22075 PRINT " faster and the final note slurred upward." 22500 RETURN 23000 '--------------------- YELLOW THROAT 23001 ' 23005 SCREEN 0: COLOR 14,0,6: CLS: LOCATE 1,30 23010 PRINT "YELLOW THROAT" 23015 LOCATE 5,1 23020 PRINT "DESCRIPTION: The male is readily identified by his black mask" 23025 PRINT " and bright yellow throat. The female is duller and lacks" 23030 PRINT " a mask. These birds frequent low vegetation in grassy " 23035 PRINT " clearings, swamps, marshes and shrubby areas, throughout the" 23040 PRINT " entire United States. They are one of our most common " 23045 PRINT " warblers, often seen near the ground, moving quickly about." 23055 PRINT 23060 PRINT "SONG: A distinctive rapid, `witchity, witchity, witchity, witch`," 23065 PRINT " repeated 4 to 6 times per minute. This is one of the easiest" 23070 PRINT " warbler songs to recognize. 23500 RETURN 24000 '--------------------- EASTERN PHOEBE 24001 ' 24005 SCREEN 0: COLOR 3,0,4: CLS: LOCATE 1,30 24010 PRINT "EASTERN PHOEBE" 24015 LOCATE 5,1 24020 PRINT "DESCRIPTION: This bird is found near farm buildings and bridges" 24025 PRINT " where it builds its nest on an over-hanging beam or ledge." 24030 PRINT " It is composed of mud, covered with moss and dead leaves," 24035 PRINT " and lined with more moss and soft feathers. It can be found" 24040 PRINT " throughout most of the eastern United States. It looks " 24045 PRINT " similar to the Eastern Wood Pewee, but has a distinctive" 24050 PRINT " song, and a habit of persistently bobbing its tail." 24055 PRINT 24060 PRINT "SONG: The phoebe clearly says its name, `phoe-be` or `fee-bree`. 24065 PRINT 24070 PRINT 24500 RETURN 25000 '--------------------- EASTERN WOOD PEWEE 25001 ' 25005 SCREEN 0: COLOR 3,0,6: CLS: LOCATE 1,30 25010 PRINT "EASTERN WOOD PEWEE" 25015 LOCATE 5,1 25020 PRINT "DESCRIPTION: One of the many flycatchers, common in deciduous" 25025 PRINT " and mixed woodland areas. It is about the size of a sparrow," 25030 PRINT " olive-brown above and whitish below. It can be distinguished" 25035 PRINT " from the similar-appearing Eastern Phoebe by its conspicuous" 25040 PRINT " wingbars and lighter-colored bill. Like the other flycatchers," 25045 PRINT " it snaps up passing insects in flight. 25055 PRINT 25060 PRINT "SONG: A plaintive, drawling whistle, `pee-o-wee` repeated" 25065 PRINT " 6 to 11 times per minute. 25500 RETURN 26000 '--------------------- WHITE-THROATED SPARROW 26001 ' 26005 LOCATE 1,30 26010 PRINT "WHITE-THROATED SPARROW" 26015 LOCATE 5,1 26020 PRINT "DESCRIPTION: One of the prettiest sparrows, with a distinctive" 26025 PRINT " white throat, a black and white striped crown and a yellow" 26030 PRINT " spot between the eye and bill. It prefers dense undergrowth" 26035 PRINT " and brushy areas, usually feeding on the ground. It can be " 26040 PRINT " attracted to winter feeding stations if seed is scattered " 26045 PRINT " on the ground." 26055 PRINT 26060 PRINT "SONG: An easily-imitated whistle, `Old Sam Peabody, Peabody," 26065 PRINT " Peabody`, as described by New Englanders or 'Oh Sweet " 26070 PRINT " Canada, Canada, Canada` by the Canadians for whom it is the" 26075 PRINT " national bird. The song is unmistakable once it has been" 26080 PRINT " heard. The initial two notes are clear, followed by the" 26085 PRINT " quavering `Peabody` notes on a different pitch." 26500 RETURN 27000 '--------------------- TOWHEE 27001 ' 27005 SCREEN 0: COLOR 10,0: CLS: LOCATE 1,30 27010 PRINT "RUFOUS-SIDED TOWHEE" 27015 LOCATE 5,1 27020 PRINT "DESCRIPTION: Feeds on the ground in brush and thick undergrowth" 27025 PRINT " where it is often detected by its noisy scratching and hopping" 27030 PRINT " amongst the dead leaves as it searches for insects and seeds." 27035 PRINT " The male is a beautiful bird with a black back and white " 27040 PRINT " belly with reddish (rufous) sides. Its eye is bright red, " 27045 PRINT " except for a white-eyed race found in the Southwest. 27050 PRINT " The female differs from the male by being dusky brown where" 27052 PRINT " the male is black. Found throughout the United States." 27055 PRINT 27060 PRINT "SONG: `Drink your tea`, with the last syllable a long " 27065 PRINT " drawn-out trill, more like `teeeee` than `tea` as the " 27070 PRINT " mnemonic would suggest. Repeated 7 to 12 times per minute." 27500 RETURN 28000 '--------------------- other birds 28001 ' 28005 RETURN 45020 'no description so return to get file 28006 ' 40000 '******* subroutine to store file on disk 40001 ' 40002 CLS 40004 LOCATE 12,10 40005 PRINT "Would you like to store the song on diskette (y/n)";:PRINT 40010 YN$ = INKEY$: IF YN$ = "" THEN GOTO 40010 40012 IF YN$ = "y" OR YN$ = "Y" THEN GOTO 40020 ELSE RETURN 40020 LOCATE 12,1:PRINT STRING$(75,32); 40021 LOCATE 12,10 40022 INPUT "Filename (8 characters or less) ";DATAFILE$ 40023 LOCATE 12,1:PRINT STRING$(75,32); 40024 LOCATE 12,10 40025 INPUT "Bird name (20 characters or less) ";BIRDNAME$ 40026 DATAFILE$ = LEFT$(DATAFILE$,8) + ".sng" 40030 OPEN DATAFILE$ FOR OUTPUT AS #2 40032 WRITE #2, BIRDNAME$ 40035 FOR I = 1 TO 640 40040 WRITE #2, B%(I) 40050 NEXT I 40060 CLOSE 40070 CLS 40080 RETURN 40081 ' 41000 '**** subroutine to read data from a file 41001 ' 41002 CLS: LOCATE 12,15 41003 PRINT "Would you like to (P)lay a song from disk "; 41004 LOCATE 13,15 41005 PRINT " -or- (C)reate your own song ?"; 41006 LOCATE 15,15: PRINT "Press [P] or [C]" 41010 GETFILE$ = INKEY$: IF GETFILE$ = "" THEN GOTO 41010 41012 IF GETFILE$ = "C" OR GETFILE$ = "c" THEN RETURN ELSE IF GETFILE$<>"P" AND GETFILE$<>"p" THEN BEEP: GOTO 41010 41015 ' 42000 '-------------------- choose a birdsong to play 42001 ' 42003 FLAG = 1 'retrieving a saved file 42005 CLS 42010 LOCATE 5,24 42020 PRINT "Choose One of the Following Birds" 42040 LOCATE 8,23: PRINT "1 ---------- Cardinal" 42050 LOCATE 9,23: PRINT "2 ---------- Yellow Warbler" 42060 LOCATE 10,23: PRINT "3 ---------- Yellow Throat" 42070 LOCATE 11,23: PRINT "4 ---------- Eastern Phoebe" 42074 LOCATE 12,23: PRINT "5 ---------- Eastern Wood Pewee" 42076 LOCATE 13,23: PRINT "6 ---------- White-Throated Sparrow" 42078 LOCATE 14,23: PRINT "7 ---------- Rufous-Sided Towhee" 42080 LOCATE 15,23: PRINT "8 ---------- Another Bird Song (not listed)" 42085 LOCATE 18,27,1: PRINT "What is your choice? (1-8) "; 42090 A$ = INKEY$: IF A$ = "" THEN GOTO 42090 ELSE PRINT A$;: LOCATE ,,0 42100 NUMBER = VAL(A$) 43100 IF NUMBER = 1 THEN FILENAME$ = "CARDNAL4.sng" 43102 IF NUMBER = 2 THEN FILENAME$ = "YL-WARB.sng" 43103 IF NUMBER = 3 THEN FILENAME$ = "YL-THRT.sng" 43104 IF NUMBER = 4 THEN FILENAME$ = "phoebe.sng" 43106 IF NUMBER = 5 THEN FILENAME$ = "pewe1.sng" 43107 IF NUMBER = 6 THEN FILENAME$ = "wht-thrt.sng" 43108 IF NUMBER = 7 THEN FILENAME$ = "towhee1.sng" 43109 IF NUMBER = 8 THEN CLS: LOCATE 8,1:FILES "*.sng": PRINT :PRINT :INPUT " Filename (without .SNG extension) "; FILENAME$: FILENAME$=FILENAME$+".SNG" 43120 IF NUMBER < 1 OR NUMBER > 8 THEN BEEP: GOTO 42005 'catch errors 44040 CLS 45010 '-- 45012 ' 45013 GOSUB 20000 45020 OPEN FILENAME$ FOR INPUT AS #1 45030 INPUT #1, BIRDNAME$ 45040 FOR I = 1 TO 640 45050 INPUT#1, B%(I) 45055 IF B%(I) = &HFFFF THEN A(I)=0 ELSE A(I) = (191*(B%(I))-26775)/B%(I) 45060 NEXT I 45070 CLOSE 45100 GOSUB 61000: GOTO 3000 50000 '*** call to machine language routine 50001 RESTORE 50020 DEF SEG = &H1700 50030 FOR I = 0 TO 67 50040 READ J 50050 POKE I,J 50060 NEXT I 50070 SING = 0 50075 FACTOR = 1 50080 LENGTH% = 1237*FACTOR ' &H4d5 = 1237 = normal tempo 50130 CALL SING(B%(1), LENGTH%) 50150 DATA &H55, &h89, &he5, &h8b, &h76, &h08, &h8b, &h6e 50160 DATA &H06, &h8b, &h6e, &h00, &hb0, &hb6, &he6, &h43 50170 DATA &he4, &h61, &h88, &hc6, &h29, &hdb, &h8b, &h00, &he6, &h42, &h88 50190 DATA &he0, &he6, &h42, &h83, &hc3, &h02, &h88, &hf0, &h0c 50195 DATA &h03, &h80, &hfc, &hff, &h74, &h04, &he6, &h61 50200 DATA &heb, &h04, &h88, &hf0, &he6, &h61, &h89, &he9, &he2, &hfe, &h81 50205 DATA &hfb, &h00, &h05, &h7c, &hda, &h88, &hf0, &he6 50220 DATA &h61, &h5d, &Hca, &h04, &h00 50555 RETURN 60000 '*** introduction 60001 ' 60002 COLOR 14,0 60003 FOR I = 1 TO 30 60004 LOCATE 1,I 60005 PRINT " BIRDSONG" 60006 FOR J = 1 TO 120: NEXT 60007 NEXT I 60008 ' 60009 BIRD$ = "c#;p64;c#;p64;c#;p16;eabcdeff#;p8" 60010 FOR I = 1 TO 4 60011 PLAY "mb o6 l64; xbird$;" 60012 NEXT I 60013 ' 60014 COLOR 3,0 60015 PRINT 60020 PRINT " BIRDSONG is a program which allows you to reproduce the songs of birds. " 60025 PRINT " Each song was first created graphically as a sonogram using the cursor keys" 60030 PRINT " to trace out the distinctive song pattern on the screen. The screen has a" 60035 PRINT " vertical axis for the tone of the song, and a horizontal axis representing" 60045 PRINT " the time in seconds." 60050 PRINT "** If you are using a computer equipped with graphics, you will be able to " 60051 PRINT " create new songs. Without graphics, you will only be able to play the songs" 60052 PRINT " that are on the disk.**" 60072 PRINT " To trace out the song pattern press [F5] to toggle the drawing mode off or " 60074 PRINT " on. Draw the sonogram by repeatedly pressing one of the four cursor keys." 60076 PRINT " To redraw the song press [F9] at any time. You may save a song on diskette" 60078 PRINT " and run the program to play any of the songs you have created." 60081 PRINT 60082 PRINT " BIRDSONG includes seven files of common bird songs along with a description" 60085 PRINT " of each bird. Other bird songs can be traced from sonograms found in bird" 60087 PRINT " field guides, or you may experiment with songs and melodies of your own" 60090 PRINT " invention." 60200 LOCATE 21,5 : COLOR 7,0 60210 PRINT "(C) Copyright 1984 Scott Camazine & P. Kirk Visscher "; 60215 PRINT " 36 DOVE DRIVE, ITHACA, NEW YORK 14850 "; 60220 PRINT " If you like and use this program, please send the author $10.00."; 60225 LOCATE 24,1: PRINT " SUPPORT THE USER SUPPORTED SOFTWARE CONCEPT."; 60300 FOR WAITE=1 TO 3000: NEXT WAITE: LOCATE 25,1: PRINT SPACE$(79); 60500 GOSUB 61000 60510 RETURN 61000 '---------------- press any key to continue 61001 ' 61002 LOCATE 25,20 61010 PRINT "Press any key to continue"; 61020 A$ = INKEY$: IF A$ = "" THEN GOTO 61020 61030 LOCATE 25,20: PRINT STRING$(40,32); 61040 'CLS 61050 RETURN 62000 '------------------ error traps 62001 ' 62010 LOCATE 14,30 62015 IF ERR = 53 THEN PRINT "File Not Found.......Please try again": GOSUB 64000: RESUME 42000 62025 IF ERR = 71 THEN PRINT "Disk Drive Not Ready....Please check drive": GOSUB 64000: RESUME 42000 62050 ' 64000 '------------------- pause 64001 ' 64010 FOR I = 1 TO 3000: NEXT I 64020 RETURN 64030 ' 65000 SCREEN 0: WIDTH 80: COLOR FC,0,BC ' return to magazette 65010 COMMON ADDR.%, COLOR.MONITOR$ 65020 'COLOR 14,0: LOCATE 25,1: PRINT SPACE$(28);"Returning to Magazette";SPACE$(29);: RUN"start" 65030 CLS: LOCATE 12,35: PRINT"Good-bye!": COLOR 3 65040 END